library(rrrsa)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(knitr)
source("viz_img.R")
norm_vec <- function(v) {
  v / sum(v)
}
normalize_rows <- function(m) {
  t(apply(m, MARGIN=1, FUN=norm_vec))
}
normalize_cols <- function(m) {
  apply(m, MARGIN=2, FUN=norm_vec)
}

3X3

m3 <- matrix(c(1, 0, 1, 0, 1, 1, 1, 0, 0), nrow = 3)
L0 <- rsa.reason(normalize_cols(m3), depth=0); L0
L1 <- rsa.reason(normalize_cols(m3), depth=1); L1
L2 <- rsa.reason(normalize_cols(m3), depth=2); L2

3X4

m3 <- matrix(c(1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0), nrow = 3)
L0 <- rsa.reason(normalize_cols(m3), depth=0); L0
L1 <- rsa.reason(normalize_cols(m3), depth=1); L1
L2 <- rsa.reason(normalize_cols(m3), depth=2); L2

4X4

m4 <- matrix(c(1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1), nrow = 4)
L0 <- rsa.reason(normalize_cols(m4), depth=0); L0
L1 <- rsa.reason(normalize_cols(m4), depth=1); L1
L2 <- rsa.reason(normalize_cols(m4), depth=2); L2
L0; L1; L2
is_separate <- function(m1, m2) {
  num_rows <- dim(m1)[1]
  num_cols <- dim(m1)[2]
  for (curr_col in 1:num_cols) {
    if (any(duplicated(m1[,curr_col]) != duplicated(m2[,curr_col]))) return(TRUE)
  }
  FALSE
}

I’m working with a transposed matrix design (utterances are cols, faces are rows). So L0 normalizes over rows.

set.seed(1)
generate_random_matrix <- function(num_rows, num_cols) {
  m <- matrix(sample(c(0, 1), size=num_rows * num_cols, replace=TRUE), nrow=num_rows)
}
generate_random_matrix(3, 3) %>%
  data.frame %>%
  kable(caption="Example generated 3X3 matrix")
Example generated 3X3 matrix
X1 X2 X3
0 1 1
0 0 1
1 1 1 
bad_matrix <- function(m) {
  num_rows <- dim(m)[1]
  num_cols <- dim(m)[2]
  for (curr_col in 1:num_cols) {
    if (all(m[, curr_col] == 0)) return(TRUE)
  }
  for (curr_row in 1:num_rows) {
    if (all(m[curr_row,] == 0)) return(TRUE)
  }
  FALSE
}

not_null <- function(x) !is.null(x)
good_matrices <- list()
for (i in seq(1,100)) {
  curr_m <- generate_random_matrix(4, 3)
  if (bad_matrix(curr_m)) next
  # print(curr_m)
  L0 <- rsa.reason(normalize_cols(curr_m), depth=0)
  L1 <- rsa.reason(normalize_cols(curr_m), depth=1)
  L2 <- rsa.reason(normalize_cols(curr_m), depth=2)
  curr_matrices <- list("original"=curr_m, "L0"=L0, "L1"=L1, "L2"=L2)
  if (is_separate(L1, L2)) good_matrices[[i]] <- curr_matrices
}
good_matrices_filtered <- Filter(not_null, good_matrices)
good_matrices_filtered
## [[1]]
## [[1]]$original
##      [,1] [,2] [,3]
## [1,]    1    1    0
## [2,]    1    1    0
## [3,]    0    0    1
## [4,]    1    0    1
## 
## [[1]]$L0
##           [,1] [,2] [,3]
## [1,] 0.3333333  0.5  0.0
## [2,] 0.3333333  0.5  0.0
## [3,] 0.0000000  0.0  0.5
## [4,] 0.3333333  0.0  0.5
## 
## [[1]]$L1
##              1   2     3
## [1,] 0.3333333 0.5 0.000
## [2,] 0.3333333 0.5 0.000
## [3,] 0.0000000 0.0 0.625
## [4,] 0.3333333 0.0 0.375
## 
## [[1]]$L2
##              1   2         3
## [1,] 0.3148148 0.5 0.0000000
## [2,] 0.3148148 0.5 0.0000000
## [3,] 0.0000000 0.0 0.6538462
## [4,] 0.3703704 0.0 0.3461538
## 
## 
## [[2]]
## [[2]]$original
##      [,1] [,2] [,3]
## [1,]    0    1    1
## [2,]    0    1    1
## [3,]    1    1    0
## [4,]    1    0    0
## 
## [[2]]$L0
##      [,1]      [,2] [,3]
## [1,]  0.0 0.3333333  0.5
## [2,]  0.0 0.3333333  0.5
## [3,]  0.5 0.3333333  0.0
## [4,]  0.5 0.0000000  0.0
## 
## [[2]]$L1
##          1         2   3
## [1,] 0.000 0.3333333 0.5
## [2,] 0.000 0.3333333 0.5
## [3,] 0.375 0.3333333 0.0
## [4,] 0.625 0.0000000 0.0
## 
## [[2]]$L2
##              1         2   3
## [1,] 0.0000000 0.3148148 0.5
## [2,] 0.0000000 0.3148148 0.5
## [3,] 0.3461538 0.3703704 0.0
## [4,] 0.6538462 0.0000000 0.0
## 
## 
## [[3]]
## [[3]]$original
##      [,1] [,2] [,3]
## [1,]    1    0    1
## [2,]    1    1    0
## [3,]    1    1    0
## [4,]    0    0    1
## 
## [[3]]$L0
##           [,1] [,2] [,3]
## [1,] 0.3333333  0.0  0.5
## [2,] 0.3333333  0.5  0.0
## [3,] 0.3333333  0.5  0.0
## [4,] 0.0000000  0.0  0.5
## 
## [[3]]$L1
##              1   2     3
## [1,] 0.3333333 0.0 0.375
## [2,] 0.3333333 0.5 0.000
## [3,] 0.3333333 0.5 0.000
## [4,] 0.0000000 0.0 0.625
## 
## [[3]]$L2
##              1   2         3
## [1,] 0.3703704 0.0 0.3461538
## [2,] 0.3148148 0.5 0.0000000
## [3,] 0.3148148 0.5 0.0000000
## [4,] 0.0000000 0.0 0.6538462

L2 separation always occurs in the column in which one of the features is shared by 3 out of 4 of the faces in the 3X4 or 4X3 matrix.

More types of L2 separation with a 4X4.

viz

good_matrices <- list()
for (i in seq(1,100)) {
  curr_m <- generate_random_matrix(3, 4)
  if (bad_matrix(curr_m)) next
  # print(curr_m)
  ImageViz(t(curr_m))
  L0 <- t(rsa.reason(normalize_cols(curr_m), depth=0))
  L1 <- t(rsa.reason(normalize_cols(curr_m), depth=1))
  L2 <- t(rsa.reason(normalize_cols(curr_m), depth=2))
  L3 <- t(rsa.reason(normalize_cols(curr_m), depth=3))
  curr_matrices <- list("original"=curr_m, "L0"=L0, "L1"=L1, "L2"=L2, "L3"=L3)
  if (is_separate(L2, L3)) good_matrices[[i]] <- curr_matrices
}

not_null <- function(x) !is.null(x)
good_matrices_filtered <- Filter(not_null, good_matrices)
good_matrices_filtered

We get L3 separation with a 6X4 or 4X6 matrix.